home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / lzhtv10.arc / DEHUF.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-21  |  11KB  |  442 lines
  1.  
  2. (* --------------------------------------------------------------
  3.  *   DEHUF.PAS
  4.  *
  5.  *   Based on decode section of lzhuf.c
  6.  *   Written by Haruyasu Yoshizaki 11/20/1988
  7.  *   Some minor changes 4/6/1989
  8.  *   Comments translated by Haruhiko Okumura 4/7/1989
  9.  *   Translated to turbo pascal by Samuel H. Smith 4/20/1989
  10.  *
  11.  *)
  12.  
  13. uses mdosio;
  14.  
  15. procedure Error(message: string);
  16. begin
  17.    writeln;
  18.    writeln(message);
  19.    halt(1);
  20. end;
  21.  
  22.  
  23. (********** LZSS compression **********)
  24.  
  25. var
  26.    infile:  dos_handle;
  27.    outfile: dos_handle;
  28.  
  29. const
  30.    textsize:   longint = 0;
  31.    printcount: longint = 0;
  32.  
  33.    N = 4096;    (* buffer size *)
  34.    F = 60;      (* lookahead buffer size *)
  35.    THRESHOLD = 2;
  36.  
  37. type
  38.    uchar = byte;
  39.  
  40. var
  41.    text_buf:   array[0..N+F-1] of uchar;
  42.    lson:   array[0..N+1] of integer;
  43.    rson:   array[0..N+257] of integer;
  44.    dad:   array[0..N+1] of integer;
  45.  
  46.  
  47. (* Huffman coding *)
  48.  
  49. const
  50.    N_CHAR = (256-THRESHOLD+F);  (* kinds of characters (code = 0..N_CHAR-1) *)
  51.    T = (N_CHAR * 2 - 1);        (* size of table *)
  52.    R = (T - 1);                 (* position of root *)
  53.    MAX_FREQ = $8000;            (* updates tree when the *)
  54.                                 (* root frequency comes to this value. *)
  55.  
  56. var
  57.    freq:   array[0..T+1] of word;   (* frequency table *)
  58.    parent:  array[0..T+N_CHAR] of word;
  59.                         (* pointers to parent nodes, except for the *)
  60.                         (* elements[T..T + N_CHAR - 1] which are used to get *)
  61.                         (* the positions of leaves corresponding to the codes. *)
  62.  
  63.    son:  array[0..T] of integer;
  64.                         (* pointers to child nodes (son[], son[] + 1) *)
  65.  
  66. const
  67.    getbuf: word = 0;
  68.    getlen: uchar = 0;
  69.  
  70. function GetBit: integer;  (* get one bit *)
  71. var
  72.    i:   byte;
  73.    
  74. begin
  75.    
  76.    while (getlen <= 8) do
  77.    begin
  78.       ReadByte(i);
  79.       getbuf := getbuf or (i shl (8 - getlen));
  80.       inc(getlen, 8);
  81.    end;
  82.    
  83.    if (getbuf and $8000) <> 0 then
  84.       GetBit := 1
  85.    else
  86.       GetBit := 0;
  87.  
  88.    getbuf := getbuf shl 1;
  89.    dec(getlen);
  90. end;
  91.  
  92. function GetByte: integer; (* get one byte *)
  93. var
  94.    i:   byte;
  95.    
  96. begin
  97.    
  98.    while (getlen <= 8) do
  99.    begin
  100.       ReadByte(i);
  101.       getbuf := getbuf or (word(i) shl (8 - getlen));
  102.       inc(getlen, 8);
  103.    end;
  104.    
  105.    GetByte := getbuf shr 8;
  106.    getbuf := getbuf shl 8;
  107.    dec(getlen, 8);
  108. end;
  109.  
  110.  
  111. (* table for encoding and decoding the upper 6 bits of position *)
  112.  
  113. (* for decoding *)
  114.    d_code: array[0..255] of uchar = (
  115.         $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
  116.         $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
  117.         $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01,
  118.         $01, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02,
  119.         $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $03,
  120.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  121.         $03, $03, $04, $04, $04, $04, $04, $04, $04, $04, $05, $05, $05,
  122.         $05, $05, $05, $05, $05, $06, $06, $06, $06, $06, $06, $06, $06,
  123.         $07, $07, $07, $07, $07, $07, $07, $07, $08, $08, $08, $08, $08,
  124.         $08, $08, $08, $09, $09, $09, $09, $09, $09, $09, $09, $0A, $0A,
  125.         $0A, $0A, $0A, $0A, $0A, $0A, $0B, $0B, $0B, $0B, $0B, $0B, $0B,
  126.         $0B, $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D, $0E, $0E, $0E, $0E,
  127.         $0F, $0F, $0F, $0F, $10, $10, $10, $10, $11, $11, $11, $11, $12,
  128.         $12, $12, $12, $13, $13, $13, $13, $14, $14, $14, $14, $15, $15,
  129.         $15, $15, $16, $16, $16, $16, $17, $17, $17, $17, $18, $18, $19,
  130.         $19, $1A, $1A, $1B, $1B, $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,
  131.         $20, $20, $21, $21, $22, $22, $23, $23, $24, $24, $25, $25, $26,
  132.         $26, $27, $27, $28, $28, $29, $29, $2A, $2A, $2B, $2B, $2C, $2C,
  133.         $2D, $2D, $2E, $2E, $2F, $2F, $30, $31, $32, $33, $34, $35, $36,
  134.         $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);
  135.  
  136.    d_len: array[0..255] of uchar = (
  137.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  138.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  139.         $03, $03, $03, $03, $03, $03, $04, $04, $04, $04, $04, $04, $04,
  140.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  141.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  142.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  143.         $04, $04, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  144.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  145.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  146.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  147.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  148.         $05, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  149.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  150.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  151.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $07, $07, $07,
  152.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  153.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  154.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  155.         $07, $07, $07, $07, $07, $07, $08, $08, $08, $08, $08, $08, $08,
  156.         $08, $08, $08, $08, $08, $08, $08, $08, $08);
  157.  
  158.  
  159. (* initialization of tree *)
  160.  
  161. procedure StartHuff;
  162. var
  163.    i:   integer;
  164.    j:   integer;
  165.    
  166. begin
  167.    
  168.    for i := 0 to N_CHAR - 1 do
  169.    begin
  170.       freq[i] := 1;
  171.       son[i] := i + T;
  172.       parent[i + T] := i;
  173.    end;
  174.    
  175.    i := 0;
  176.    j := N_CHAR;
  177.    while (j <= R) do
  178.    begin
  179.       freq[j] := freq[i] + freq[i + 1];
  180.       son[j] := i;
  181.       parent[i] := j;
  182.       parent[i + 1] := j;
  183.       inc(i, 2);
  184.       inc(j);
  185.    end;
  186.    
  187.    freq[T] := $ffff;
  188.    parent[R] := 0;
  189. end;
  190.  
  191.  
  192. (* reconstruction of tree *)
  193.  
  194. procedure reconst;
  195. var
  196.    i,j,k:  integer;
  197.    f,l:    word;
  198.    
  199. begin
  200.  
  201. (* collect leaf nodes in the first half of the table *)
  202. (* and replace the freq by (freq + 1) / 2. *)
  203.    j := 0;
  204.    for i := 0 to T - 1 do
  205.    begin
  206.       
  207.       if (son[i] >= T) then
  208.       begin
  209.          freq[j] := (freq[i] + 1) div 2;
  210.          son[j] := son[i];
  211.          inc(j);
  212.       end;
  213.    end;
  214.  
  215.  
  216. (* begin constructing tree by connecting sons *)
  217.    
  218.    i := 0;
  219.    for j := N_CHAR to T - 1 do
  220.    begin
  221.       k := i + 1;
  222.       f := freq[i] + freq[k];
  223.       freq[j] := f;
  224.  
  225.       k := j - 1;
  226.       while (f < freq[k]) do
  227.          dec(k);
  228.       
  229.       inc(k);
  230.       l := (j - k) * 2;
  231.  
  232.       move(freq[k], freq[k+1], l);
  233.       freq[k] := f;
  234.  
  235.       move(son[k], son[k+1], l);
  236.       son[k] := i;
  237.  
  238.       inc(i, 2);
  239.    end;
  240.  
  241.  
  242. (* connect parent *)
  243.  
  244.    for i := 0 to T - 1 do
  245.    begin
  246.       k := son[i];
  247.       if k >= T then
  248.          parent[k] := i
  249.       else
  250.       begin
  251.          parent[k] := i;
  252.          parent[k + 1] := i;
  253.       end;
  254.    end;
  255. end;
  256.  
  257.  
  258. (* increment frequency of given code by one, and update tree *)
  259.  
  260. procedure update (c:   integer);
  261. var
  262.    i,j,k,l:   integer;
  263.    
  264. begin
  265.    
  266.    if (freq[R] = MAX_FREQ) then
  267.       reconst;
  268.    
  269.    c := parent[c + T];
  270.    
  271.    repeat
  272.       inc(freq[c]);
  273.       k := freq[c];
  274.  
  275. (* if the order is disturbed, exchange nodes *)
  276.  
  277.       l := c+1;
  278.       if (k > freq[l]) then
  279.       begin
  280.          repeat
  281.             inc(l);
  282.          until k <= freq[l];
  283.          
  284.          dec(l);
  285.          freq[c] := freq[l];
  286.          freq[l] := k;
  287.  
  288.          i := son[c];
  289.  
  290.          parent[i] := l;
  291.          if (i < T) then
  292.             parent[i + 1] := l;
  293.          
  294.          j := son[l];
  295.          son[l] := i;
  296.  
  297.          parent[j] := c;
  298.          if (j < T) then
  299.             parent[j + 1] := c;
  300.          
  301.          son[c] := j;
  302.          c := l;
  303.       end;
  304.       
  305.       c := parent[c];
  306.  
  307.    until c = 0;   (* repeat up to root *)
  308. end;
  309.  
  310. function DecodeChar: integer;
  311. var
  312.    c:    word;
  313.    b:    word;
  314. begin
  315.    c := son[R];
  316.  
  317. (* travel from root to leaf, *)
  318. (* choosing the smaller child node (son[]) if the read bit is 0, *)
  319. (* the bigger (son[] +1end; if 1 *)
  320.    
  321.    while (c < T) do
  322.    begin
  323.       b := GetBit;
  324.       inc(c,b);
  325.       c := son[c];
  326.    end;
  327.    
  328.    dec(c, T);
  329.    update(c);
  330.    DecodeChar := c;
  331. end;
  332.  
  333. function DecodePosition: integer;
  334. var
  335.    i,j,c:   word;
  336.    
  337. begin
  338.  
  339. (* recover upper 6 bits from table *)
  340.    i := GetByte;
  341.    c := d_code[i] shl 6;
  342.    j := d_len[i];
  343.  
  344. (* read lower 6 bits verbatim *)
  345.    dec(j, 2);
  346.    while j <> 0 do
  347.    begin
  348.       dec(j);
  349.       i := (i shl 1) + GetBit;
  350.    end;
  351.    
  352.    DecodePosition := c or (i and $3f);
  353. end;
  354.  
  355. procedure Decode; (* recover *)
  356. var
  357.    i,j,k,r,c:   integer;
  358.    count:   longint;
  359.    
  360. begin
  361.    
  362. (* read size of text *)
  363.    if dos_read(infile, textsize, sizeof(textsize)) <> sizeof(textsize) then
  364.       Error('Can''t read');
  365.  
  366.    if (textsize = 0) then
  367.       exit;
  368.  
  369.    StartHuff;
  370.  
  371.    for i := 0 to N - F - 1 do
  372.       text_buf[i] := ord(' ');
  373.  
  374.    r := N - F;
  375.    count := 0;
  376.    while count < textsize do
  377.    begin
  378.       c := DecodeChar;
  379.       if (c < 256) then
  380.       begin
  381.          dos_write(outfile, c, 1);
  382.          text_buf[r] := c;
  383.          inc(r);
  384.          r := r and (N - 1);
  385.          inc(count);
  386.       end
  387.       else
  388.  
  389.       begin
  390.          i := (r - DecodePosition - 1) and (N - 1);
  391.          j := c - 255 + THRESHOLD;
  392.       
  393.          for k := 0 to j - 1 do
  394.          begin
  395.             c := text_buf[(i+k) and (N-1)];
  396.             dos_write(outfile, c, 1);
  397.             text_buf[r] := c;
  398.             inc(r);
  399.             r := r and (N - 1);
  400.             inc(count);
  401.          end;
  402.       end;
  403.  
  404.       if (count > printcount) then
  405.       begin
  406.          write(count : 12, #13);
  407.          inc(printcount, 1024);
  408.       end;
  409.    end;
  410.  
  411.    writeln(count:12);
  412. end;
  413.  
  414.  
  415. (* main block *)
  416.  
  417. begin
  418.    if paramcount <> 2 then
  419.    begin
  420.       writeln('Decodes files encoded with Haruyasu Yoshizaki's lzhuf.');
  421.       writeln('Usage: dehuf infile outfile');
  422.       halt(1);
  423.    end;
  424.    
  425.    infile := dos_open(paramstr(1), open_read);
  426.    
  427.    if infile = dos_error then
  428.       error('Can''t open: ' + paramstr(1));
  429.    
  430.    outfile := dos_create(paramstr(2));
  431.    
  432.    if outfile = dos_error then
  433.       error('Can''t create: ' + paramstr(2));
  434.    
  435.    Decode;
  436.  
  437.    dos_close(infile);
  438.    dos_close(outfile);
  439.    halt(0);
  440. end.
  441.  
  442.